home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcpursut.arc / PCPUR.PRG < prev    next >
Encoding:
Text File  |  1987-01-07  |  8.9 KB  |  354 lines
  1. Procedure pursuit
  2. Use pcpur
  3. set index to pcpur
  4. set format to pcpur
  5. set bell off
  6. set escape off
  7. set safety off
  8. SET TALK OFF
  9. SET MARGIN TO 5
  10. DO WHILE .T.
  11. CLEAR
  12. ?'     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
  13. ?'     *                   PC-Pursuit BBS List                   *'
  14. ?'     * * * * * * * * * * * * MAIN MENU * * * * * * * * * * * * *'
  15. ?''
  16. ?'     A)dd to list or Edit              L)ist or Print'
  17. ?'     I)ndex (sort)                     S)earch'
  18. ?'     Q)uit                             Z) printer setup'
  19. ?' '
  20. ?' '
  21. ?'       Copyright 1987, Maggard Technologies and Kevin Maggard'
  22. ?'     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
  23. ?
  24. ?
  25. ?
  26. ?
  27. WAIT '    OPTION?--> ' to opt
  28. if upper(opt)<>'Q'
  29. ?'Please wait, performing task'
  30. endif
  31. do case
  32.     case upper(opt)='A'
  33.         append
  34.     case upper(opt)='L'
  35.         do lbl
  36.     case upper(opt)='Q'
  37.         wait 'quit, are you sure?' to opt2
  38.             if upper(opt2)='Y'
  39.                 quit
  40.             else endcase opt
  41.                 endif
  42.     case upper(opt)='I'
  43.         do ndex2
  44.    case upper(opt)='S'
  45.         do serch2
  46.     case upper(opt)='Z'
  47.         close databases
  48.         close index
  49.         close format
  50.         do epson2
  51.     endcase opt
  52. enddo
  53. return
  54. procedure ndex2
  55. do while .T.
  56. clear
  57. ?'* * * * * * * * * * * * * Index menu * * * * * * * * * * * * *'
  58. ?
  59. ?' Index on what field?         1) Area Code'
  60. ?'                              2) Phone Number'
  61. ?'                              3) Name'
  62. ?'                              4) Note1'
  63. ?'                              5) Note2'
  64. ?
  65. ?' L) to display list           Q) to return to main menu'
  66. ?'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
  67. wait  'Field #?--> ' to fld
  68. ?'Please wait...'
  69. do case
  70.     case fld='1'
  71.         index on acode to pcpur
  72.     case fld='2'
  73.         index on phone to pcpur
  74.     case fld='3'
  75.         index on upper(name) to pcpur
  76.     case fld='4'
  77.          index on note1 to pcpur
  78.     case fld='5'
  79.         index on note2 to pcpur
  80.     case upper(fld)='L'
  81. ?
  82. ?
  83. ?
  84.       label form pcpur
  85.             wait
  86.     case upper(fld)='Q'
  87.         return
  88. endcase
  89. enddo
  90. return
  91. procedure serch2
  92. do while .T.
  93. clear
  94. ?'* * * * * * * * * * * * Search menu * * * * * * * * * * * * *'
  95. ?
  96. ?' Search on what field?        1) Area Code'
  97. ?'                              2) Phone Number'
  98. ?'                              3) BBS Name'
  99. ?'                              4) Note1'
  100. ?'                              5) Note2'
  101. ?'  Q) to return to main menu'
  102. ?'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
  103. wait  'Search field #? ' to fld
  104. do case
  105.     case fld='1'
  106.         accept'Area Code to search for?' to ac
  107.     ?
  108. ?
  109.     display all for at(ac,acode)>0 off
  110.             wait
  111.     case fld='2'
  112.         accept'Phone Number to search for?' to phn
  113. ?
  114. ?
  115.        display all for at(phn,phone)>0 off
  116.             wait
  117.     case fld='3'
  118.         accept'Name to search for?' to nme
  119.  ?
  120. ?
  121.  display all for at(upper(nme),upper(name))>0 off
  122.        wait
  123.        case fld='4'
  124. accept 'Note1 to search for?' to n1
  125. ?
  126. ?
  127.  display all for at(upper(n1),upper(note1))>0 off
  128.  wait
  129.        case fld='5'
  130.  accept'Note2 to search for?' to n2
  131. ?
  132. ?
  133. display all for at(upper(n2),upper(note2))>0 off
  134. wait
  135.     case upper(fld)='Q'
  136.     return
  137. endcase
  138. enddo
  139. return
  140. procedure lbl
  141. do while .T.
  142. clear
  143. ?'* * * * * * * * * * Listing and Printing * * * * * * * * * *'
  144. ?'  Enter search parameter for each field. Hit <RETURN> for'
  145. ?'  fields that you do not want to restrict.'
  146. ?'  Enter 0 for Area Code, Number or name to abort'
  147. ?' '
  148. ?'* * * * * * * * * * * * * * *  * * * * * * * * * * * * * * *'
  149. ?
  150. release all
  151.        accept 'Area Code: ' to ac
  152.        if ac='0'
  153.        return
  154.        endif
  155.        accept 'Phone Number: ' to phn
  156.        if phn='0'
  157.        return
  158.        endif
  159.        accept 'Name: ' to nme
  160.        if nme='0'
  161.        return
  162.        endif
  163.  accept'Note1: ' to n1
  164.  accept'Note2: ' to n2
  165.  ?
  166.  ?'Where would you like your output to go?'
  167.  wait 'P)rinter, S)creen, or A)bort? ' to opt
  168.  
  169.     if Upper(opt)='A'
  170.         return
  171.    endif
  172. ?
  173.  ? 'Selecting only the records that you wanted'
  174.  
  175.  ?
  176.    delete for substr(acode,1,len(ac))<>upper(ac)
  177.    delete for substr(phone,1,len(phn))<>phn
  178. if len(nme)<>0
  179.    delete for at(upper(nme),upper(name))=0
  180. endif
  181. if len(n1)<>0
  182.    delete for at(upper(n1),upper(note1))=0
  183. endif
  184. if len(n2)<>0
  185.    delete for at(upper(n2),upper(note2))=0
  186. endif
  187.    if upper(opt)='P'
  188. ?
  189. ?'  Make sure printer is online.'
  190. ?
  191. wait
  192. display all for .not. deleted() to print off
  193.   recall all for deleted()
  194. ?
  195. ?'End of Listing...'
  196.        else
  197. ?
  198. ?
  199. display all for .not. deleted() off
  200.  recall all for deleted()
  201. ?
  202. ?'End of Listing...'
  203. wait
  204. endif
  205.   enddo
  206. return
  207. procedure epson2
  208. * Michael Wade COMPUSERVE 75126,2113
  209. * Advantage Associates, Inc. ... 3406 Fleetwood Dr... Lexington,KY.
  210. * June 1985... revised August 1985
  211. *
  212. SET TALK OFF
  213. SET EXACT ON
  214. STORE DATE() TO MDATE
  215. STORE '   ' TO check
  216. CLEAR
  217. ?'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
  218. ?? '~~~~~~'
  219. @ 2,10 SAY ' Printer Control Utility Menu (for Epson & Compats)'
  220. @ 4,0 SAY ' Advantage Associates Inc. Lexington,Ky.'+SPACE(30)+DTOC(mdate)
  221. @ 6,5 SAY '1 - Condensed ON                     A - Condensed OFF'
  222. @ 7,5 SAY '2 - Wide ON                          B - Wide OFF'
  223. @ 8,5 SAY '3 - Emphasized ON                    C - Emphasized OFF'
  224. @ 9,5 SAY '4 - Double Strike ON                 D - Double Strike  OFF'
  225. @ 10,5 SAY '5 - Italic ON                        E - Italic OFF'
  226. @ 11,5 SAY '6 - Underline ON                     F - Underline OFF'
  227. @ 12,5 SAY '7 - Superscript ON                   G - Superscript OFF'
  228. @ 13,5 SAY '8 - Subscript ON                     H - Subscript OFF'
  229. @ 14,5 SAY '9 - Elite ON                         I - Elite OFF'
  230. @ 15,4 SAY '10 - Emphasized Double Strike ON      J - Emphasized Double'
  231.     ?? ' Strike OFF'
  232. @ 16,4 SAY '11 - Ring Bell                        K - Re-Set to defaults'
  233. @ 18,24 SAY 'X -> Exit with no changes'
  234. @ 21,0 SAY ' '
  235. ?'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
  236. ?? '~~~~~~'
  237. @ 20,20 SAY 'Please make a selection : ' GET check PICTURE '!!!'
  238. READ
  239. SET CONSOLE OFF
  240. SET PRINT ON
  241. DO CASE
  242.     * bail out !!
  243.     CASE check='  '.OR. check='X'
  244.         SET PRINT OFF
  245.         SET CONSOLE ON
  246.         CLEAR
  247.         use pcpur
  248.         set index to pcpur
  249.         return
  250.     * compressed on
  251.     CASE check='1'
  252.         ? CHR(15)
  253.         STORE 'Compressed ON' TO huh
  254.     * compressed off
  255.     CASE check='A'
  256.         ? CHR(18)
  257.         STORE 'Compressed OFF' TO huh
  258.     * wide on
  259.     CASE check='2'
  260.         ? CHR(27)+CHR(87)+CHR(49)
  261.         STORE 'Wide ON' TO huh
  262.     * wide off
  263.     CASE check='B'
  264.         ? CHR(27)+CHR(87)+CHR(48)
  265.         STORE 'Wide OFF' TO huh
  266.     * emphasized on
  267.     CASE check='3'
  268.         ? CHR(27)+CHR(69)
  269.         STORE 'Emphasized ON' TO huh
  270.     * emphasized off
  271.     CASE check='C'
  272.         ? CHR(27)+CHR(70)
  273.         STORE 'Emphasized OFF' TO huh
  274.     * double strike on
  275.     CASE check='4'
  276.         ? CHR(27)+CHR(71)
  277.         STORE 'Double Strike ON' TO huh
  278.     * double strike off
  279.     CASE check='D'
  280.         ? CHR(27)+CHR(72)
  281.         STORE 'Double Strike OFF' TO huh
  282.     * italic on
  283.     CASE check='5'
  284.         ? CHR(27)+CHR(52)
  285.         STORE 'Italics ON' TO huh
  286.     * italic off
  287.     CASE check='E'
  288.         ? CHR(27)+CHR(53)
  289.         STORE 'Italics OFF' TO huh
  290.     * underline on
  291.     CASE check='6'
  292.         ? CHR(27)+"-1"
  293.         STORE 'Underline ON' TO huh
  294.     * underline off
  295.     CASE check='F'
  296.         ? CHR(27)+"-0"
  297.         STORE 'Underline OFF' TO huh
  298.     * superscript on
  299.     CASE check='7'
  300.         ? CHR(27)+CHR(83)+CHR(48)
  301.         STORE 'Superscript ON' TO huh
  302.     * superscript off OR subscript off
  303.     CASE check='G'.OR. check='H'
  304.         ? CHR(27)+CHR(84)
  305.         STORE 'Super/Sub script OFF' TO huh
  306.     * subscript on
  307.     CASE check='8'
  308.         ? CHR(27)+CHR(83)+CHR(49)
  309.         STORE 'Subscript ON' TO huh
  310.     * elite on
  311.     CASE check='9'
  312.         ? CHR(27)+CHR(77)
  313.         STORE 'Elite ON' TO huh
  314.     * elite off
  315.     CASE check='I'
  316.         ? CHR(27)+CHR(80)
  317.         STORE 'Elite OFF' TO huh
  318.     * ring bell
  319.     CASE check='11'
  320.         ? CHR(7)
  321.     * re-set to defaults
  322.     CASE check='K'
  323.         ? CHR(27)+CHR(64)
  324.         STORE 'Default' TO huh
  325.     * emphasized + double strike on
  326.     CASE check='10'
  327.         ? CHR(27)+CHR(69)+CHR(27)+CHR(71)
  328.         STORE 'Emphasized + Double Strike ON' TO huh
  329.     * emphasized + double strike off
  330.     CASE check='J'
  331.         ? CHR(27)+CHR(64)
  332.         STORE 'Default' TO huh
  333. ENDCASE [check]
  334. SET PRINT OFF
  335. SET CONSOLE ON
  336. @ 23,20 SAY "Printer's "+huh+" installed ..."
  337. ?? CHR(7)
  338. WAIT
  339. CLEAR
  340. use pcpur
  341. set index to pcpur
  342. set format to pcpur
  343. set bell off
  344. set escape off
  345. set safety off
  346. SET TALK OFF
  347. SET HEADING on
  348. SET MARGIN TO 5
  349. RETURN
  350. return
  351.  
  352.  
  353.  
  354.